Nothing but Tetris/Nothing but Tetris.iso/amiga/shapes/autoexec.amos/autoexec.amosSourceCode

AMOS Source Code | 1991-05-17 | 26KB | 885 lines

Dim HIGH_NAME$(10),HIGH_SCORE(10),SHAPES(7)
Global HIGH_NAME$(),HIGH_SCORE(),SHAPES()
Global LEVEL,SCORE,LEVEL_TIME,SPACES,PATH$,SHAPE,ROTATION,OUT_OF_TIME
Global GAME_OVER,PLACE_MODE,OK,P1,P2,P3,P4,P5,P6,P7,P8,P9,CODE$,M_FLAG,C_FLAG
Break Off : PATH$="SYS:"
'
'
A_INITIALISATION
B_MAIN_PROGRAM
'
'
Procedure A_INITIALISATION
   CODE$="SHAPE"
   C_FLAG=False
   AA_READ_HIGH_SCORES
   AB_LOAD_AND_PACK_TITLE_SCREEN
   AC_LOAD_BOB_DATA
   AD_LOAD_MUSIC
   AE_LOAD_SAMPLES
End Proc
Procedure AA_READ_HIGH_SCORES
   If Exist(PATH$+"scores")
      Open In 1,PATH$+"scores"
      For I=1 To 10
         Input #1,HIGH_NAME$(I),S$
         HIGH_SCORE(I)=Val(S$)
      Next I
      Close 1
   Else
      Restore HIGH_SCORE_DEFAULTS
      For I=1 To 10
         Read HIGH_NAME$(I),HIGH_SCORE(I)
      Next I
   End If
   HIGH_SCORE_DEFAULTS:
   Data "BEATMASTER",500
   Data "BEATMASTER",450
   Data "BEATMASTER",400
   Data "BEATMASTER",350
   Data "BEATMASTER",300
   Data "BEATMASTER",250
   Data "BEATMASTER",200
   Data "BEATMASTER",150
   Data "BEATMASTER",100
   Data "BEATMASTER",50
End Proc
Procedure AB_LOAD_AND_PACK_TITLE_SCREEN
   Load Iff PATH$+"title.iff",0
   Screen Hide 0
   Curs Off : Flash Off : Hide
   Pack 0 To 6
End Proc
Procedure AC_LOAD_BOB_DATA
   Load PATH$+"Bobs.ABK"
End Proc
Procedure AD_LOAD_MUSIC
  Load PATH$+"music.abk"
  Music 1
  Tempo 17
  M_FLAG=True
End Proc
Procedure AE_LOAD_SAMPLES
  Load PATH$+"samples.abk"
End Proc
Procedure B_MAIN_PROGRAM
   Repeat
      XA_RESTORE_SCREEN
      Pen 24
      Paper 0
      Print At(11,8);"F1 : PLAY GAME"
      Print At(11,10);"F2 : HIGH SCORES"
      Print At(11,12);"F3 : INSTRUCTIONS"
      Pen 21
      Print At(11,16);"   CODE: ";CODE$
      Pen 9
      Print At(11,24);" WRITTEN IN AMOS "
      If C_FLAG
        Pen 12
        Print At(11,22);"  CHEAT MODE ON  "
      End If
      XD_DISPLAY_LEVEL
      XF_DISPLAY_SCORE
      XB_FADE_IN_PALETTE
      Repeat
         Repeat
            K$=Inkey$
         Until K$<>""
         K$=Upper$(K$)
         If(K$>="A") and(K$<="Z")
           CODE$=Right$(CODE$,4)+K$
           Pen 21
           Print At(20,16);CODE$
           If CODE$="PENIS"
             C_FLAG=True
           End If
           If CODE$="FANNY"
             C_FLAG=False
           End If
         End If
         If C_FLAG
           Pen 12
           Print At(11,22);"  CHEAT MODE ON  "
         Else
           Print At(11,22);"                 "
         End If
         S=Scancode
         If S=80 Then BA_PLAY_GAME
         If S=81 Then BB_HIGH_SCORES
         If S=82 Then BC_INSTRUCTIONS
      Until S=80 or S=81 or S=82
      Repeat
      Until Inkey$=""
   Until False
End Proc
Procedure BA_PLAY_GAME
   XA_RESTORE_SCREEN
   BAA_INITIALISE_GAME
   Repeat
      BAB_INITIALISE_LEVEL
      XB_FADE_IN_PALETTE
      Limit Mouse X Hard(84),Y Hard(61) To X Hard(219),Y Hard(196)
      Timer=0
      BAC_PLAY_LEVEL
      If Not GAME_OVER Then BAE_LEVEL_COMPLETE
   Until GAME_OVER
   If OUT_OF_TIME Then BAD_OUT_OF_TIME
   If SCORE>HIGH_SCORE(10) Then BAF_HIGH_SCORE
End Proc
Procedure BAA_INITIALISE_GAME
   GAME_OVER=False
   SCORE=0
   LEVEL=1
   XH_LEVEL_CODES["CHECK"]
End Proc
Procedure BAB_INITIALISE_LEVEL
   SPACES=0
   SHAPE=1
   ROTATION=1
   PLACE_MODE=True
   OUT_OF_TIME=False
   Open Random 1,PATH$+"level-data"
   Field 1,333 As L$
   Get 1,LEVEL
   Ink 0
   Bob Off 1
   Wait Vbl
   Bar 84,61 To 227,204
   LEVEL_TIME=Asc(Left$(L$,1))*256+Asc(Mid$(L$,2,1))
   Ink 0,30
   For I=1 To 7
      SHAPES(I)=Asc(Mid$(L$,2+I,1))
      Text 16+33*I,250,Right$("0"+Str$(SHAPES(I))-" ",2)
   Next I
   Ink 6
   For I=1 To 18
      For J=1 To 18
         X$=Mid$(L$,9+(I-1)*18+J,1)
         If X$="X" Then Bar 76+J*8,53+I*8 To 83+J*8,60+I*8
         If X$=" " Then Inc SPACES
      Next J
   Next I
   Ink 21,5
   XC_DISPLAY_TIME[LEVEL_TIME]
   XD_DISPLAY_LEVEL
   XE_DISPLAY_SPACES
   Close 1
End Proc
Procedure BAC_PLAY_LEVEL
   FINISH=False
   Repeat
      X=X Screen(X Mouse)
      Y=Y Screen(Y Mouse)
      M=Mouse Click
      K$=Inkey$
      If PLACE_MODE
         Bob 1,Int(X/8)*8-4,Int(Y/8)*8-3,SHAPE*8+4+ROTATION
         If M and 1
            BACD_PUT_DOWN_PIECE[X,Y]
         End If
         If M and 2
            Add ROTATION,1,1 To 4
         End If
      Else
         Bob 1,Int(X/8)*8+7,Int(Y/8)*8+8,58
         If M and 1
            BACE_PICK_UP_PIECE[Int(X/8)*8+7,Int(Y/8)*8+8]
         End If
      End If
      If(M and 4) or(K$=" ") Then BACA_FLIP_MODE
      If(K$="m") or(K$="M")
        If M_FLAG
          Music Off
          M_FLAG=False
        Else
          Music 1 : Tempo 17
          M_FLAG=True
        End If
      End If
      If K$=Chr$(27) Then GAME_OVER=True
      XC_DISPLAY_TIME[LEVEL_TIME-Timer/50]
      BACB_CHECK_FUNC_KEYS
      BACC_CHECK_TIMER
      If((K$="n") or(K$="N")) and C_FLAG Then SPACES=0
      If SPACES=0 Then FINISH=True : LEVEL_TIME=LEVEL_TIME-Timer/50
   Until FINISH or GAME_OVER
End Proc
Procedure BACA_FLIP_MODE
   If PLACE_MODE
      PLACE_MODE=False
      Ink 21,5
      Text 22,201,"ERASE"
   Else
      PLACE_MODE=True
      Ink 21,5
      Text 22,201,"PLACE"
   End If
End Proc
Procedure BACB_CHECK_FUNC_KEYS
   If Key State(80) Then SHAPE=0
   If Key State(81) Then SHAPE=1
   If Key State(82) Then SHAPE=2
   If Key State(83) Then SHAPE=3
   If Key State(84) Then SHAPE=4
   If Key State(85) Then SHAPE=5
   If Key State(86) Then SHAPE=6
End Proc
Procedure BACC_CHECK_TIMER
   If Timer/50>LEVEL_TIME
      GAME_OVER=True
      OUT_OF_TIME=True
   End If
End Proc
Procedure BACD_PUT_DOWN_PIECE[X,Y]
   Bob Off 1
   OK=True
   X=Int(X/8)*8-4
   Y=Int(Y/8)*8-3
   P1=(Point(X+3,Y+3)<>0)
   P2=(Point(X+11,Y+3)<>0)
   P3=(Point(X+19,Y+3)<>0)
   P4=(Point(X+3,Y+11)<>0)
   P5=(Point(X+11,Y+11)<>0)
   P6=(Point(X+19,Y+11)<>0)
   P7=(Point(X+3,Y+19)<>0)
   P8=(Point(X+11,Y+19)<>0)
   P9=(Point(X+19,Y+19)<>0)
   If SHAPE=0 Then BACDA_CHECK_SHAPE_0
   If SHAPE=1 Then BACDB_CHECK_SHAPE_1
   If SHAPE=2 Then BACDC_CHECK_SHAPE_2
   If SHAPE=3 Then BACDD_CHECK_SHAPE_3
   If SHAPE=4 Then BACDE_CHECK_SHAPE_4
   If SHAPE=5 Then BACDF_CHECK_SHAPE_5
   If SHAPE=6 Then BACDG_CHECK_SHAPE_6
   If SHAPES(SHAPE+1)=0 Then OK=False : Sample 3 To 4 : Play 4,40,16 : Play 4,37,1
   If OK Then BACDH_PASTE_SHAPE[X,Y]
End Proc
Procedure BACDA_CHECK_SHAPE_0
   If P2 or P4 or P5 or P6 or P8
      OK=False
   End If
End Proc
Procedure BACDB_CHECK_SHAPE_1
   If ROTATION=1 and(P2 or P4 or P5 or P7)
      OK=False
   End If
   If ROTATION=2 and(P1 or P2 or P5 or P6)
      OK=False
   End If
   If ROTATION=3 and(P3 or P5 or P6 or P8)
      OK=False
   End If
   If ROTATION=4 and(P4 or P5 or P8 or P9)
      OK=False
   End If
End Proc
Procedure BACDC_CHECK_SHAPE_2
   If ROTATION=1 and(P2 or P5 or P8 or P9)
      OK=False
   End If
   If ROTATION=2 and(P4 or P5 or P6 or P7)
      OK=False
   End If
   If ROTATION=3 and(P1 or P2 or P5 or P8)
      OK=False
   End If
   If ROTATION=4 and(P3 or P4 or P5 or P6)
      OK=False
   End If
End Proc
Procedure BACDD_CHECK_SHAPE_3
   If ROTATION=1 and(P2 or P4 or P5 or P8)
      OK=False
   End If
   If ROTATION=2 and(P2 or P4 or P5 or P6)
      OK=False
   End If
   If ROTATION=3 and(P2 or P5 or P6 or P8)
      OK=False
   End If
   If ROTATION=4 and(P4 or P5 or P6 or P8)
      OK=False
   End If
End Proc
Procedure BACDE_CHECK_SHAPE_4
   If ROTATION=1 and(P1 or P4 or P5 or P7 or P8)
      OK=False
   End If
   If ROTATION=2 and(P1 or P2 or P3 or P4 or P5)
      OK=False
   End If
   If ROTATION=3 and(P2 or P3 or P5 or P6 or P9)
      OK=False
   End If
   If ROTATION=4 and(P5 or P6 or P7 or P8 or P9)
      OK=False
   End If
End Proc
Procedure BACDF_CHECK_SHAPE_5
   If ROTATION=1 and(P2 or P3 or P5 or P8 or P9)
      OK=False
   End If
   If ROTATION=2 and(P4 or P5 or P6 or P7 or P9)
      OK=False
   End If
   If ROTATION=3 and(P1 or P2 or P5 or P7 or P8)
      OK=False
   End If
   If ROTATION=4 and(P1 or P3 or P4 or P5 or P6)
      OK=False
   End If
End Proc
Procedure BACDG_CHECK_SHAPE_6
   If(ROTATION=1 or ROTATION=3) and(P1 or P2 or P5 or P8 or P9)
      OK=False
   End If
   If(ROTATION=2 or ROTATION=4) and(P3 or P4 or P5 or P6 or P7)
      OK=False
   End If
End Proc
Procedure BACDH_PASTE_SHAPE[X,Y]
   Bob Off 1
   Wait Vbl
   Paste Bob X,Y,SHAPE*8+ROTATION
   GX=(X-84)/8+1
   GY=(X-61)/8+1
   If SHAPE=0 Then SPACES=SPACES-5 : SCORE=SCORE+5
   If SHAPE=1 Then SPACES=SPACES-4 : SCORE=SCORE+4
   If SHAPE=2 Then SPACES=SPACES-4 : SCORE=SCORE+4
   If SHAPE=3 Then SPACES=SPACES-4 : SCORE=SCORE+4
   If SHAPE=4 Then SPACES=SPACES-5 : SCORE=SCORE+5
   If SHAPE=5 Then SPACES=SPACES-5 : SCORE=SCORE+5
   If SHAPE=6 Then SPACES=SPACES-5 : SCORE=SCORE+5
   Dec SHAPES(SHAPE+1)
   XE_DISPLAY_SPACES
   XF_DISPLAY_SCORE
   XG_DISPLAY_SHAPE_COUNTS
End Proc
Procedure BACE_PICK_UP_PIECE[X,Y]
   Bob Off 1
   Wait Vbl
   P=Point(X,Y)
   If P=9 Then BACEA_PICK_SHAPE_0[X,Y]
   If P=24 Then BACEB_PICK_SHAPE_1[X,Y]
   If P=21 Then BACEC_PICK_SHAPE_2[X,Y]
   If P=15 Then BACED_PICK_SHAPE_3[X,Y]
   If P=18 Then BACEE_PICK_SHAPE_4[X,Y]
   If P=27 Then BACEF_PICK_SHAPE_5[X,Y]
   If P=12 Then BACEG_PICK_SHAPE_6[X,Y]
   XE_DISPLAY_SPACES
   XF_DISPLAY_SCORE
   XG_DISPLAY_SHAPE_COUNTS
End Proc
Procedure BACEA_PICK_SHAPE_0[X,Y]
   If Point(X-3,Y)=9 and Point(X+4,Y)<>9 Then X=X-8
   If Point(X+4,Y)=9 and Point(X-3,Y)<>9 Then X=X+8
   If Point(X,Y-3)=9 and Point(X,Y+4)<>9 Then Y=Y-8
   If Point(X,Y+4)=9 and Point(X,Y-3)<>9 Then Y=Y+8
   X=X-11
   Y=Y-11
   Ink 0
   Bar X+8,Y To X+15,Y+23
   Bar X,Y+8 To X+23,Y+15
   SPACES=SPACES+5
   SCORE=SCORE-5
   Inc SHAPES(1)
End Proc
Procedure BACEB_PICK_SHAPE_1[X,Y]
   P1=(Point(X-3,Y)=24) : N1=(Point(X-3,Y)<>24)
   P2=(Point(X,Y-3)=24) : N2=(Point(X,Y-3)<>24)
   P3=(Point(X+4,Y)=24) : N3=(Point(X+4,Y)<>24)
   P4=(Point(X,Y+4)=24) : N4=(Point(X,Y+4)<>24)
   If N1 and N2 and N3 and P4 Then R=1 : Y=Y+8
   If P1 and P2 and N3 and N4 Then R=1
   If N1 and N2 and P3 and P4 Then R=1 : X=X+8
   If N1 and P2 and N3 and N4 Then R=1 : X=X+8 : Y=Y-8
   If N1 and N2 and P3 and N4 Then R=2 : X=X+8 : Y=Y+8
   If P1 and N2 and N3 and P4 Then R=2 : Y=Y+8
   If N1 and P2 and P3 and N4 Then R=2
   If P1 and N2 and N3 and N4 Then R=2 : X=X-8
   X=X-11 : Y=Y-11
   Ink 0
   If R=1
      Bar X+8,Y To X+15,Y+15
      Bar X,Y+8 To X+7,Y+23
   End If
   If R=2
      Bar X,Y To X+15,Y+7
      Bar X+8,Y+8 To X+23,Y+15
   End If
   SPACES=SPACES+4
   SCORE=SCORE-4
   Inc SHAPES(2)
End Proc
Procedure BACEC_PICK_SHAPE_2[X,Y]
   BACEC_RECHECK:
   P1=(Point(X-3,Y)=21) : N1=(Point(X-3,Y)<>21)
   P2=(Point(X,Y-3)=21) : N2=(Point(X,Y-3)<>21)
   P3=(Point(X+4,Y)=21) : N3=(Point(X+4,Y)<>21)
   P4=(Point(X,Y+4)=21) : N4=(Point(X,Y+4)<>21)
   P5=(Point(X-11,Y+3)=21) : N5=(Point(X-11,Y+3)<>21)
   P6=(Point(X+3,Y-11)=21) : N6=(Point(X+3,Y-11)<>21)
   P7=(Point(X+12,Y+3)=21) : N7=(Point(X+12,Y+3)<>21)
   P8=(Point(X+3,Y+12)=21) : N8=(Point(X+3,Y+12)<>21)
   If N1 and N2 and N3 and P4 and P8 Then R=1 : Y=Y+8
   If N1 and P2 and N3 and P4 Then Y=Y-8 : Goto BACEC_RECHECK
   If N1 and P2 and P3 and N4 Then R=1 : Y=Y-8
   If P1 and N2 and N3 and N4 and N5 Then R=1 : Y=Y-8 : X=X-8
   If N1 and N2 and P3 and P4 Then R=2 : X=X+8
   If P1 and N2 and P3 and N4 Then X=X-8 : Goto BACEC_RECHECK
   If P1 and N2 and N3 and N4 and P5 Then R=2 : X=X-8
   If N1 and P2 and N3 and N4 and N6 Then R=2 : X=X+8 : Y=Y-8
   If N1 and N2 and P3 and N4 and N7 Then R=3 : X=X+8 : Y=Y+8
   If P1 and N2 and N3 and P4 Then R=3 : Y=Y+8
   If N1 and P2 and N3 and N4 and P6 Then R=3 : Y=Y-8
   If N1 and N2 and N3 and P4 and N8 Then R=4 : Y=Y+8 : X=X-8
   If N1 and N2 and P3 and N4 and P7 Then R=4 : X=X+8
   If P1 and P2 and N3 and N4 Then R=4 : X=X-8
   X=X-11 : Y=Y-11
   Ink 0
   If R=1
      Bar X+8,Y To X+15,Y+23
      Bar X+16,Y+16 To X+23,Y+23
   End If
   If R=2
      Bar X,Y+8 To X+23,Y+15
      Bar X,Y+16 To X+7,Y+23
   End If
   If R=3
      Bar X,Y To X+15,Y+7
      Bar X+8,Y To X+15,Y+23
   End If
   If R=4
      Bar X+16,Y To X+23,Y+7
      Bar X,Y+8 To X+23,Y+15
   End If
   SPACES=SPACES+4
   SCORE=SCORE-4
   Inc SHAPES(3)
End Proc
Procedure BACED_PICK_SHAPE_3[X,Y]
   BACED_RECHECK:
   P1=(Point(X-3,Y)=15) : N1=(Point(X-3,Y)<>15)
   P2=(Point(X,Y-3)=15) : N2=(Point(X,Y-3)<>15)
   P3=(Point(X+4,Y)=15) : N3=(Point(X+4,Y)<>15)
   P4=(Point(X,Y+4)=15) : N4=(Point(X,Y+4)<>15)
   If N1 and N2 and N3 and P4 Then Y=Y+8 : Goto BACED_RECHECK
   If N1 and N2 and P3 and N4 Then X=X+8 : Goto BACED_RECHECK
   If P1 and N2 and N3 and N4 Then X=X-8 : Goto BACED_RECHECK
   If N1 and P2 and N3 and N4 Then Y=Y-8 : Goto BACED_RECHECK
   If P1 and P2 and N3 and P4 Then R=1
   If P1 and P2 and P3 and N4 Then R=2
   If N1 and P2 and P3 and P4 Then R=3
   If P1 and N2 and P3 and P4 Then R=4
   Ink 0
   X=X-11 : Y=Y-11
   Bar X+8,Y+8 To X+15,Y+15
   If R=1 or R=2 or R=4 Then Bar X,Y+8 To X+7,Y+15
   If R=1 or R=2 or R=3 Then Bar X+8,Y To X+15,Y+8
   If R=2 or R=3 or R=4 Then Bar X+16,Y+8 To X+23,Y+15
   If R=1 or R=3 or R=4 Then Bar X+8,Y+16 To X+15,Y+23
   SPACES=SPACES+4
   SCORE=SCORE-4
   Inc SHAPES(4)
End Proc
Procedure BACEE_PICK_SHAPE_4[X,Y]
   BACEE_RECHECK:
   P1=(Point(X-3,Y)=18) : N1=(Point(X-3,Y)<>18)
   P2=(Point(X,Y-3)=18) : N2=(Point(X,Y-3)<>18)
   P3=(Point(X+4,Y)=18) : N3=(Point(X+4,Y)<>18)
   P4=(Point(X,Y+4)=18) : N4=(Point(X,Y+4)<>18)
   If N1 and N2 and P3 and P4 Then X=X+8 : Goto BACEE_RECHECK
   If P1 and N2 and N3 and P4 Then Y=Y+8 : Goto BACEE_RECHECK
   If P1 and P2 and N3 and N4 Then X=X-8 : Goto BACEE_RECHECK
   If N1 and P2 and P3 and N4 Then Y=Y-8 : Goto BACEE_RECHECK
   If N1 and N2 and N3 and P4 Then R=1 : X=X+8 : Y=Y+8
   If P1 and N2 and N3 and N4 Then R=2 : X=X-8 : Y=Y+8
   If N1 and P2 and N3 and N4 Then R=3 : X=X-8 : Y=Y-8
   If N1 and N2 and P3 and N4 Then R=4 : X=X+8 : Y=Y-8
   If N1 and P2 and P3 and P4 Then R=1 : X=X+8
   If P1 and N2 and P3 and P4 Then R=2 : Y=Y+8
   If P1 and P2 and N3 and P4 Then R=3 : X=X-8
   If P1 and P2 and P3 and N4 Then R=4 : Y=Y-8
   X=X-11 : Y=Y-11
   Ink 0
   If R=1
      Bar X,Y To X+7,Y+7
      Bar X,Y+8 To X+15,Y+23
   End If
   If R=2
      Bar X,Y To X+15,Y+15
      Bar X+16,Y To X+23,Y+7
   End If
   If R=3
      Bar X+8,Y To X+23,Y+15
      Bar X+16,Y+16 To X+23,Y+23
   End If
   If R=4
      Bar X,Y+16 To X+7,Y+23
      Bar X+8,Y+8 To X+23,Y+23
   End If
   SPACES=SPACES+5
   SCORE=SCORE-5
   Inc SHAPES(5)
End Proc
Procedure BACEF_PICK_SHAPE_5[X,Y]
BACEF_RECHECK:
  P1=(Point(X-3,Y)=27) : N1=(Point(X-3,Y)<>27)
  P2=(Point(X,Y-3)=27) : N2=(Point(X,Y-3)<>27)
  P3=(Point(X+4,Y)=27) : N3=(Point(X+4,Y)<>27)
  P4=(Point(X,Y+4)=27) : N4=(Point(X,Y+4)<>27)
  XX=X : YY=Y
  If N1 and N2 and P3 and P4 and Point(XX,YY+12)=27 Then R=1 : Y=Y+8
  If N1 and P2 and N3 and P4 and Point(XX-3,YY+8)<>27 Then R=1
  If N1 and P2 and P3 and N4 and Point(XX,YY-11)=27 Then R=1 : Y=Y-8
  If P1 and N2 and N3 and N4 and Point(XX-8,YY-3)<>27 Then R=1 : X=X-8 : Y=Y+8
  If P1 and N2 and N3 and N4 and Point(XX-8,YY-3)=27 Then R=1 : X=X-8 : Y=Y-8
  If N1 and N2 and P3 and P4 and Point(XX,YY+12)<>27 Then R=2 : X=X+8
  If P1 and N2 and P3 and N4 and Point(XX+8,YY-3)<>27 Then R=2
  If P1 and N2 and N3 and P4 and Point(XX-11,YY)=27 Then R=2 : X=X-8
  If N1 and P2 and N3 and N4 and Point(XX-3,YY-8)<>27 Then R=2 : X=X+8 : Y=Y-8
  If N1 and P2 and N3 and N4 and Point(XX-3,YY-8)=27 Then R=2 : X=X-8 : Y=Y-8
  If N1 and N2 and P3 and N4 and Point(XX+8,YY-3)<>27 Then R=3 : X=X+8 : Y=Y+8
  If N1 and N2 and P3 and N4 and Point(XX+8,YY-3)=27 Then R=3 : X=X+8 : Y=Y-8
  If P1 and N2 and N3 and P4 and Point(XX,YY+12)=27 Then R=3 : Y=Y+8
  If N1 and P2 and N3 and P4 and Point(XX-3,YY+8)=27 Then R=3
  If P1 and P2 and N3 and N4 and Point(XX-11,YY)<>27 Then R=3 : Y=Y-8
  If N1 and N2 and N3 and P4 and Point(XX+4,YY+8)=27 Then R=4 : X=X+8 : Y=Y+8
  If N1 and N2 and N3 and P4 and Point(XX+4,YY+8)<>27 Then R=4 : X=X-8 : Y=Y+8
  If N1 and P2 and P3 and N4 and Point(XX,YY-11)<>27 Then R=4 : X=X+8
  If P1 and N2 and P3 and N4 and Point(XX+8,YY-3)=27 Then R=4
  If P1 and P2 and N3 and N4 and Point(XX-11,YY)=27 Then R=4 : X=X-8
  X=X-11 : Y=Y-11
  Ink 0
  If R=1 or R=3 Then Bar X+8,Y To X+15,Y+23
  If R=2 or R=4 Then Bar X,Y+8 To X+23,Y+15
  If R=3 or R=4 Then Bar X,Y To X+7,Y+7
  If R=1 or R=4 Then Bar X+16,Y To X+23,Y+7
  If R=1 or R=2 Then Bar X+16,Y+16 To X+23,Y+23
  If R=2 or R=3 Then Bar X,Y+16 To X+7,Y+23
  SPACES=SPACES+5
  SCORE=SCORE-5
  Inc SHAPES(6)
End Proc
Procedure BACEG_PICK_SHAPE_6[X,Y]
  P1=(Point(X-3,Y)=12) : N1=(Point(X-3,Y)<>12)
  P2=(Point(X,Y-3)=12) : N2=(Point(X,Y-3)<>12)
  P3=(Point(X+4,Y)=12) : N3=(Point(X+4,Y)<>12)
  P4=(Point(X,Y+4)=12) : N4=(Point(X,Y+4)<>12)
  If N1 and N2 and P3 and N4 Then R=1 : X=X+8 : Y=Y+8
  If P1 and N2 and N3 and P4 Then R=1 : Y=Y+8
  If N1 and P2 and N3 and P4 Then R=1
  If N1 and P2 and P3 and N4 Then R=1 : Y=Y-8
  If P1 and N2 and N3 and N4 Then R=1 : X=X-8 : Y=Y-8
  If N1 and N2 and N3 and P4 Then R=2 : X=X-8 : Y=Y+8
  If N1 and N2 and P3 and P4 Then R=2 : X=X+8
  If P1 and N2 and P3 and N4 Then R=2
  If P1 and P2 and N3 and N4 Then R=2 : X=X-8
  If N1 and P2 and N3 and N4 Then R=2 : X=X+8 : Y=Y-8
  X=X-11 : Y=Y-11
  Ink 0
  Bar X+8,Y+8 To X+15,Y+15
  If R=1
    Bar X,Y To X+15,Y+7
    Bar X+8,Y+16 To X+23,Y+23
  End If
  If R=2
    Bar X,Y+8 To X+7,Y+23
    Bar X+16,Y To X+23,Y+15
  End If
  SPACES=SPACES+5
  SCORE=SCORE-5
  Inc SHAPES(7)
End Proc
Procedure BAD_OUT_OF_TIME
   Ink 8
   Bar 105,124 To 206,139
   Pen 31 : Paper 8
   Print At(14,16);"OUT OF TIME"
   Ink 10
   Box 105,124 To 206,139
   Box 107,126 To 204,137
   Sample 1 To 4
   Play 4,40,50
   XH_WAIT
End Proc
Procedure BAE_LEVEL_COMPLETE
   If M_FLAG Then Mvolume 0
   Sample 2 To 4
   Play 4,40,63
   If M_FLAG Then Mvolume 63
   For I=LEVEL_TIME To 0 Step -1
      Inc SCORE
      Wait Vbl
      Wait Vbl
      Wait Vbl
      XC_DISPLAY_TIME[I]
      XF_DISPLAY_SCORE
   Next I
   LEVEL=LEVEL+1
   If LEVEL<=50
      Ink 0
      Bar 84,61 To 227,204
      Pen 21
      Print At(12,12);"LEVEL COMPLETE!"
      Print At(11,16);"CODE FOR LEVEL";Str$(LEVEL)
      Pen 24
      XH_LEVEL_CODES["SET"]
      Print At(17,18);CODE$
      XH_WAIT
      Fade 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
   Else
      GAME_OVER=True
      BAEE_ADD_LEVEL_BONUS
   End If
End Proc
Procedure BAEE_ADD_LEVEL_BONUS
  Ink 0
  Bar 84,61 To 227,204
  Pen 21
  Print At(11,12);"CONGRATULATIONS!!"
  Print At(11,14);"YOU HAVE FINISHED"
  Print At(11,16);"   THE GAME!!!   "
  XH_WAIT
End Proc
Procedure BAF_HIGH_SCORE
   XA_RESTORE_SCREEN
   XD_DISPLAY_LEVEL
   XF_DISPLAY_SCORE
   P=10
   For I=10 To 1 Step -1
     If SCORE>HIGH_SCORE(I) Then P=I
   Next I
   For I=10 To P+1 Step -1
     HIGH_NAME$(I)=HIGH_NAME$(I-1)
     HIGH_SCORE(I)=HIGH_SCORE(I-1)
   Next I
   HIGH_SCORE(P)=SCORE
   HIGH_NAME$(P)="??????????"
   Paper 0
   For I=1 To 10
      If I=P Then Pen 27 Else Pen 21
      Print At(11,9+I);HIGH_NAME$(I);" ";Right$(("00000"+(Str$(HIGH_SCORE(I))-" ")),5);
   Next I
   Pen 18
   Print At(11,8);"   HIGH SCORES   "
   Pen 12
   Print At(11,21);"   WELL DONE!!   "
   Print At(11,22);" ENTER YOUR NAME "
   Print At(11,24);"  [          ]"
   XB_FADE_IN_PALETTE
   N$=""
   Pen 24
   Repeat
     Print At(14,24);Left$(N$+"          ",10)
     K$=Upper$(Inkey$)
     If Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ !@#$%^&*()-=+.,:;?/`'",K$)
       If Len(N$)<10
         N$=N$+K$
       Else
         N$=Right$(N$,9)+K$
       End If
     End If
   Until K$=Chr$(13)
   HIGH_NAME$(P)=Left$(N$+"          ",10)
   Open Out 1,PATH$+"scores"
   For I=1 To 10
     Print #1,HIGH_NAME$(I)
     Print #1,(Str$(HIGH_SCORE(I))-" ")
   Next I
   Close 1
   BB_HIGH_SCORES
End Proc
Procedure XH_LEVEL_CODES[M$]
   If M$="SET"
     Restore CODES
     For I=1 To LEVEL
       Read CODE$
     Next I
   End If
   If M$="CHECK"
     Restore CODES
     LEVEL=1
     Read C$
     While(C$<>CODE$) and(C$<>"*")
       Inc LEVEL
       Read C$
     Wend
     If C$="*"
       LEVEL=1
     End If
   End If
CODES: Data "SHAPE","AMIGA","MOUSE","TANGO","CUBIK"
       Data "XENON","QUEEN","APRIL","TASTE","PENNY"
       Data "TRUTH","POWER","TURBO","MUSIC","MATEY"
       Data "SOUND","WORLD","STYLE","VIRUS","PRINT"
       Data "MILKY","KNOCK","BRAIN","GAZZA","ISSUE"
       Data "MATCH","SMURF","PRIZE","TEDDY","GROUP"
       Data "DIANE","SMALL","UNITE","PAINT","VIDEO"
       Data "STILL","INPUT","OFFER","FIRST","ORION"
       Data "PIANO","SHARE","OASIS","KINKY","MORPH"
       Data "NINJA","STONE","GREEN","OZONE","CHIPS"
       Data "*"
End Proc
Procedure BB_HIGH_SCORES
   XA_RESTORE_SCREEN
   Paper 0
   Pen 21
   For I=1 To 10
      Print At(11,9+I);HIGH_NAME$(I);"  ";Right$(("00000"+(Str$(HIGH_SCORE(I))-" ")),5);
   Next I
   Pen 18
   Print At(11,8);"   HIGH SCORES   "
   Pen 12
   Print At(11,23);"PRESS ANY KEY TO"
   Print At(11,24);" RETURN TO MENU "
   XB_FADE_IN_PALETTE
   Repeat : Until Inkey$=""
   Repeat : Until Inkey$<>""
End Proc
Procedure BC_INSTRUCTIONS
  BCA_SCREEN_MASK
  Print At(11,10);"THE OBJECT OF THE"
  Print At(11,11);" GAME IS TO FILL "
  Print At(11,12);"THE BLACK AREA OF"
  Print At(11,13);" THE BOARD USING "
  Print At(11,14);"THE SHAPES AT THE"
  Print At(11,15);"  BOTTOM OF THE  "
  Print At(11,16);"     SCREEN.     "
  Print At(11,18);"HOWEVER, YOU ONLY"
  Print At(11,19);" HAVE SO MANY OF "
  Print At(11,20);"EACH SHAPE TO USE"
  Print At(11,21);" AS INDICATED BY "
  Print At(11,22);" THE VALUE BELOW "
  Print At(11,23);"   THE SHAPES.   "
  XB_FADE_IN_PALETTE
  XH_WAIT
  BCA_SCREEN_MASK
  Print At(11,10);"  TO PUT DOWN A  "
  Print At(11,11);"SHAPE SIMPLY MOVE"
  Print At(11,12);"TO WHERE YOU WANT"
  Print At(11,13);"IT WITH THE MOUSE"
  Print At(11,14);"  AND CLICK THE  "
  Print At(11,15);"LEFT MOUSE BUTTON"
  Print At(11,17);" THE RIGHT MOUSE "
  Print At(11,18);"   BUTTON WILL   "
  Print At(11,19);"ROTATE THE SHAPE."
  Print At(11,21);"TO SELECT ANOTHER"
  Print At(11,22);" SHAPE PRESS THE "
  Print At(11,23);" FUNCTION KEY OF "
  Print At(11,24);" THAT SHAPES NO. "
  XB_FADE_IN_PALETTE
  XH_WAIT
  BCA_SCREEN_MASK
  Print At(11,10);"  PRESSING THE   "
  Print At(11,11);"SPACE BAR (OR THE"
  Print At(11,12);"MIDDLE BUTTON ON "
  Print At(11,13);"SOME MOUSES) WILL"
  Print At(11,14);" TOGGLE YOU INTO "
  Print At(11,15);"   ERASE MODE.   "
  Print At(11,17);"IN THIS MODE JUST"
  Print At(11,18);" CLICK ON ANY OF "
  Print At(11,19);"THE SHAPES ON THE"
  Print At(11,20);"BOARD AND IT WILL"
  Print At(11,21);" BE REMOVED FROM "
  Print At(11,22);"    THE BOARD.   "
  XB_FADE_IN_PALETTE
  XH_WAIT
  BCA_SCREEN_MASK
  Print At(11,10);"WHEN YOU COMPLETE"
  Print At(11,11);"EACH LEVEL A CODE"
  Print At(11,12);"WILL BE GIVEN FOR"
  Print At(11,13);" THE NEXT LEVEL. "
  Print At(11,14);"ENTERING THE CODE"
  Print At(11,15);"  ON THE TITLE-  "
  Print At(11,16);"SCREEN WILL ALLOW"
  Print At(11,17);"YOU TO START THE "
  Print At(11,18);"  GAME AT THAT   "
  Print At(11,19);"      LEVEL.     "
  XB_FADE_IN_PALETTE
  XH_WAIT
  BCA_SCREEN_MASK
  Print At(11,10);"PRESSING `M' WILL"
  Print At(11,11);"TURN THE MUSIC ON"
  Print At(11,12);"     OR OFF."
  Print At(11,14);" `ESC' WILL EXIT "
  Print At(11,15);"THE CURRENT GAME."
  XB_FADE_IN_PALETTE
  XH_WAIT
  BCA_SCREEN_MASK
  Print At(11,10);"THIS GAME IS DISK"
  Print At(11,11);"WARE. DISKWARE IS"
  Print At(11,12);" LIKE SHAREWARE, "
  Print At(11,13);" BUT INSTEAD OF  "
  Print At(11,14);"SENDING MONEY YOU"
  Print At(11,15);"MUST SEND A DISK "
  Print At(11,16);"CONTAINING A P.D."
  Print At(11,17);" PROGRAM TO THE  "
  Print At(11,18);"     AUTHOR.     "
  Print At(11,20);"ALLOWING FOR THE "
  Print At(11,21);"PRICE OF POSTAGE "
  Print At(11,22);" THATS ABOUT 70P "
  Print At(11,23);"FOR A FULL GAME!!"
  XB_FADE_IN_PALETTE
  XH_WAIT
  BCA_SCREEN_MASK
  Print At(11,10);"SEND DONATIONS TO"
  Print At(11,12);"MIKE ARCHER"
  Print At(11,13);"29 HOLBECK AVE"
  Print At(11,14);"MARTON"
  Print At(11,15);"BLACKPOOL"
  Print At(11,16);"FY4 4LS"
  Print At(11,18);" IF I DO NOT GET "
  Print At(11,19);" A GOOD RESPONSE "
  Print At(11,20);"THEN FUTURE GAMES"
  Print At(11,21);"  WILL BE MADE   "
  Print At(11,22);"  LICENSEWARE.   "
  Pen 24
  Print At(11,24);" (SO BE HONEST!) "
  XB_FADE_IN_PALETTE
  XH_WAIT
End Proc
Procedure BCA_SCREEN_MASK
  XA_RESTORE_SCREEN
  Pen 9
  Print At(11,8);"GAME INSTRUCTIONS"
  Pen 21
End Proc
Procedure XA_RESTORE_SCREEN
   Fade 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
   Wait 30
   Unpack 6
   Screen Show 0 : Rem  This is just incase screen isn't showing already
End Proc
Procedure XB_FADE_IN_PALETTE
   Fade 2,$0,$F00,$F77,$FFF,$C6F,$333,$555,$777,$809,$F0F,$F7F,$A,$F,$78F,$B60,$F80,$FA4,$88,$DD,$AFF,$90,$F0,$AFA,$800,$F00,$F77,$870,$CC0,$FF7,$999,$CCC,$FFF
   Wait 30
   Shift Up 5,1,3,1
End Proc
Procedure XC_DISPLAY_TIME[T]
   Ink 21,5 : If T<0 Then T=0
   Text 28,141,Str$(T/60)-" "
   Text 40,141,Right$("00"+Str$(T mod 60)-" ",2)
End Proc
Procedure XD_DISPLAY_LEVEL
   Ink 21,5
   Text 30,111,Right$(("00"+Str$(LEVEL)-" "),3)
End Proc
Procedure XE_DISPLAY_SPACES
   Ink 21,5
   Text 30,171,Right$(("00"+Str$(SPACES)-" "),3)
End Proc
Procedure XF_DISPLAY_SCORE
   Ink 21,5
   Text 21,81,Right$("0000"+Str$(SCORE)-" ",5)
End Proc
Procedure XG_DISPLAY_SHAPE_COUNTS
   Ink 0,30
   For I=1 To 7
      Text 16+33*I,250,Right$("0"+Str$(SHAPES(I))-" ",2)
   Next I
End Proc
Procedure XH_WAIT
  Repeat : Until(Inkey$="") and(Mouse Click=0)
  Repeat : Until(Inkey$<>"") or(Mouse Click<>0)
End Proc